Eine Einführung
AE Psychologische Methodenlehre, Philipps-Universität Marburg
2023-06-23
graphicalVAR: idiographische NetzwerkemlVAR: MultilevelGIMME: idionomischmgm: Mixed models & zeitlich variierendDSEM(MPlus): komplexe MessmodelleBGGM. Bayesianischpsychonetrics: übergreifende Architekturdynr: Dynamische SystemeHintergrund:
Sehr wichtiger Schritt
Einfluss von Datenvorverarbeitung auf Ergebnisse wird oftmals unterschätzt!
Abhängig vom Package
graphicalVAR: Dataframe im Long-Format (jede Beobachtung eine Zeile)GIMME: Listenformat oder individuelle Datenfiles in einem OrdnerAbhängig vom Package:
graphicalVAR: Akzeptiert keine fehlenden Daten. Imputation vorab, etwa univariat über Kalman-Filter aus (na_kalman aus tsImpute)Hoch relevant für die Interpretation!
Mehrere Möglichkeiten:
Explizite Modellierung über continuous-time Modellierung (ctsem)
Auslassen von Effekten über die Nacht in graphicalVAR oder GIMME
Cubic Spline Interpolation (s. Fisher et al., 2017)
Ignorieren 😓
graphicalVARund GIMME: Normalverteilte VariablengraphicalVAR (Espkamp, 2018) ermöglicht idiographische NetzwerkanalysenInterpretation von Heterogenität
Netzwerke sehen durch Schätzunsicherheit oft heterogener aus, als sie tatsächlich sind (Hoekstra et al., 2022; Siepe et al., in prep.)
fit <- graphicalVAR(
data = NULL, # Datensatz
nLambda = 50, # Anzahl von LASSO Parametern, die getestet wird
gamma = 0.5, # EBIC Hyperparameter
scale = TRUE, # z-standardisieren (wichtig für LASSO!)
vars = NULL, # Vektor mit Variablennamen
beepvar = "beep", # Beepvariable
dayvar = "day", # Tagesvariable
idvar = "id" # ID der Person
)Vorab gestellte Fragen:
Wichtigkeit von nLambda?
Umgang mit EBIC Hyperparameter \(\gamma\)
Einfluss von Detrending
Lags bei graphicalVAR
nLambda?A: Anzahl unterschiedlicher LASSO Regularisierungsparameter. Nicht unter 50 wählen, bei mehr als 50 sollte sich in der Regel nicht allzu viel ändern-
A: Wird gerade bei wenigen Daten oftmals auf 0 gesetzt (s. Mansueto et al, 2022). Dann wird EBIC zum normalen BIC. Abhängig vom Ziel der Untersuchung (Spezifizität vs. Sensitivität).
A: Scheinzusammenhänge zwischen Variablen, die eigentlich nicht miteinander zusammenhängen
graphicalVARA: Bei Spezifikation von Beep-Variable wird der Effekt vom letzten Beep eines Tages auf den nächsten nicht geschätzt
graphicalVAR: Schätzt erst temporal, dann contemporaneousGIMME: gerichtet zwischen beobachteten VariablengraphicalVAR: ungerichtet zwischen Residuenhybrid-GIMME (Luo et al., 2023): Verbindet beides! Braucht aber auch mehr DatenZusatzinformation
Beide Modelle können mathematisch ineinander transformiert werden (Luo et al., 2023)
\[ \eta_{i,t} = (\color{Red}{A_i} + \color{Blue}{A^S_{i,k}} + \color{orange}{A^g_i})\eta_{i,t} + (\color{Red}{\phi_i} + \color{Blue}{\phi^s_{i,k}} + \color{orange}{\phi^g_i})\eta_{i,t-1} + \zeta_{i,t} \] \(\eta_{i,t}\): Daten von Individuum \(i\) zum Zeitpunkt \(t\)
\(A\): Contemporaneous Effekte
\(\phi\): Temporale Effekte (VAR-1 Modell)
Orange: Gruppeneffekte
Blau: Subgruppeneffekte
Rot: Individuelle Effekte
\(\zeta_{i,t}\): Residuum von Individuum \(i\) zum Zeitpunkt \(t\)
fit <- gimmeSEM(
data = NULL, # Datenfile
out = NULL, # Outputordner
ar = TRUE, # Autoregressive Effekt schätzen (empfohlen)
plot = TRUE, # Plotten?
subgroup = TRUE, # Subgruppen schätzen?
hybrid = FALSE, # directed & undirected contemporaneous
groupcutoff = .75, # Gruppencutoff
subcutoff = .51, # Subgruppencutoff
...
)Vorab gestellte Fragen:
NA für die Nacht, damit der Nachteffekt nicht geschätzt wirdBei Weglassen von Nachteffekten verringert sich die effektive Stichprobengröße (egal in welchem Package)!
Wir treffen die notwendigen Vorbereitungen und laden die relevanten Daten. Diese wurden bereits vorab in das notwendige Listenformat umgewandelt und etwas vorverarbeitet, Code dafür ist vorhanden.
file_list <- list.files(here::here("Anwendungs_Workshop/data/individual_files"),
full.names = TRUE)
data_list <- lapply(file_list, read.csv)
# Zeitvariable hinzufügen
data_list <- lapply(data_list, function(x){
x <- x |>
dplyr::mutate(time = dplyr::row_number())
})
saveRDS(data_list, here::here("Anwendungs_Workshop/data/data_list.RDS"))Jedes Individuum hat einen eigenen Eintrag in einer Liste.
Für Personen 1, 5 und 10ein Histogramm von Dominance erstellen:
Für bessere Übersicht: Deskriptive Statistiken aller Variablen:
# relevante Variablen
rel_vars <- c("Dominance", "Affiliation", "PosAff",
"NegAff", "Stress", "Functioning")
# Berechnen von Mean und SD
desc_list <- list()
for(p in 1:length(data_list)){
desc_list[[p]] <- data_list[[p]] |>
summarize(across(all_of(rel_vars),
list(mean = mean, sd = sd), na.rm = TRUE))
}
df_desc <- bind_rows(desc_list, .id = "id")
df_desc |>
summarize(across(everything(),
~ round(mean(.), 3))) id Dominance_mean Dominance_sd Affiliation_mean Affiliation_sd PosAff_mean
1 NA 0.491 2.711 1.912 3.333 2.666
PosAff_sd NegAff_mean NegAff_sd Stress_mean Stress_sd Functioning_mean
1 0.61 1.786 0.516 2.425 2.391 1.147
Functioning_sd
1 0.69
Wir detrenden einen linearen Effekt von Zeit:
# relevante Variablen
rel_vars <- c("Dominance", "Affiliation", "PosAff",
"NegAff", "Stress", "Functioning")
# Loopen über alle p Participants
for(p in 1:length(data_list)){
data_list[[p]] <- fn_detrend(data_list[[p]],
vars = rel_vars,
time_var = "time",
sig_only = FALSE)
}
# Zeitvariable wieder löschn
for(p in 1:length(data_list)){
data_list[[p]] <- subset(data_list[[p]], select = -c(time))
}lapply für die Arbeit mit Listen# lapply statt for loop
mean_list <- lapply(data_list, function(x){
# x: einzelnes Element von data_list
mean(x$Dominance, na.rm = TRUE)
})
# oder als Datensatz verwenden
df_data <- data_list |>
# mit ID abspeichern
tibble::enframe(name = "ID") |>
# in dataframe verwandeln
tidyr::unnest()
# zurück in Liste verwandeln
data_list_new <- split(df_data, df_data$ID)fit <- gimmeSEM(
data = data_list,
out = "Anwendungs_Workshop/output",
ar = TRUE, # Autoregressive Effekt schätzen (oftmals empfohlen)
plot = TRUE, # Plotten?
subgroup = TRUE, # Subgruppen schätzen?
hybrid = FALSE, # directed & undirected contemporaneous
groupcutoff = .75, # Gruppencutoff
subcutoff = .51 # Subgruppencutoff
)
saveRDS(fit, "Anwendungs_Workshop/output/fit.RDS")Alternativ: Fertiges Modell laden
Warning
Achtung: Datenstruktur ist anders als z.B. in qgraph (Reihe: Outcome, Spalte: Prädiktor)
Hauptoutput: summaryFit.csv
summary_matrix <- read.csv(here("Anwendungs_Workshop/output/summaryPathCountsMatrix.csv"))
summary_matrix Dominancelag Affiliationlag PosAfflag NegAfflag Stresslag Functioninglag
1 94 6 4 3 2 4
2 5 94 3 5 3 2
3 3 1 94 7 4 4
4 2 4 0 94 8 4
5 2 4 2 6 94 3
6 6 5 2 4 3 94
Dominance Affiliation PosAff NegAff Stress Functioning
1 0 12 24 11 12 9
2 9 0 52 51 23 8
3 38 15 0 13 4 12
4 5 11 8 0 94 5
5 11 8 7 3 0 6
6 5 33 22 15 14 0
Subgroups Plot.pdfsubgroup*k*plot.pdfInterpretation von Subgruppen
Es kann Subgruppen ohne gemeinsames Edge geben!
GIMME als InputEventuell hilfreich: - in welchen Kovariaten unterscheiden sich Subgruppen? - etwa: Diagnose, Symptomschwere, …
indivPathEstimates.csvindiv_path_estimates <- read.csv(here::here("Anwendungs_Workshop/output/indivPathEstimates.csv"))
head(indiv_path_estimates) file lhs op rhs beta se z
1 subj1 Dominance ~ Dominancelag 0.15393445 0.10759290 1.4307120
2 subj1 Affiliation ~ Affiliationlag 0.04664781 0.10062964 0.4635594
3 subj1 PosAff ~ PosAfflag 0.15342392 0.10560389 1.4528246
4 subj1 NegAff ~ NegAfflag 0.30312911 0.07923098 3.8258911
5 subj1 Stress ~ Stresslag -0.13781602 0.09704545 -1.4201183
6 subj1 Functioning ~ Functioninglag 0.11067356 0.10096105 1.0962005
pval level sub_membership
1 0.1525127743 group 3
2 0.6429634791 group 3
3 0.1462724589 group 3
4 0.0001302999 group 3
5 0.1555732427 group 3
6 0.2729910401 group 3
Latente Variablen
GIMME mit exogenen Variablen (Beltz & Gates, 2017)
etwa: Zeit, Intervention
CS-GIMME: Confirmatory Subgroups
etwa: wie unterscheiden sich Diagnosegruppen in ihren Dynamiken
ms-GIMME, Auswahl mit AICBeispieldaten aus dem Package:
::: {.panel-tabset}
https://meghan.rbind.io/blog/quarto-slides/ https://www.emilhvitfeldt.com/post/slidecraft-colors-fonts/